;; $Id: dsprob.scm,v 1.2 2001/03/22 17:51:06 btomas Exp $
;; file    : dsprob.scm
;; created : December 1995
;; author  : George Celniker
;; comment : This file contains simple test sequences that were
;;           found helpful in debugging the development of this
;;           system.  Unfortunately this file is not complete
;;           and many of the test require an interactive observation
;;           to see that everything is ok.  Clearly this testing
;;           stuff can be improved.

;; contains :
;;
;** check-pinned-mesh - fails
;; dexit          = bug free exit sequence
;; patch-bug2     = a patch case that used to fail
;; patch-bug      = a patch case that used to fail
;; patch-bug3     = a patch case that used to fail
;; circ-patch     = a patch with circular seam
;; thorn-patch    = a long tall patch case
;; patch-face     = a generic patch case
;; patch-edge     = a patch for an edge
;  patch-circ     = commented out.  Why?
;  copy-patch-face= commented out.  Why?

;; refacet( . e)  = sequence to force the graphical update of the
;;                  ENTITY e (default e=ds-model).
;;
;; cmX()          = sequences to test commit-to-face.
;;                  sequences cm0 to cm6 are accumulative that
;;                  is cm6 is a superset of cm0.  Once cm5 is
;;                  running no need to run cm0 to cm4.
;;
;; save(cm)       = an extension of the cm commands to include save
;;                  and load sequences.  Argument cm is one of cm0,
;;                  cm1, cm2, cm3, cm4, cm5, or cm6
;;
;;            cm0 = no tag objects
;;            cm1 = added pt and crv cstrn objects
;;            cm2 = added distributed pressures
;;            cm3 = added spring load
;;            cm4 = added curve load
;;            cm5 = added multiples of above
;;            cm6 = added deletes and multiple commits
;;
;; cross()        = a curve load x in the center of a 6x6
;;                  control-point square
;;
;; base-face()    = create a 2x2 degree-1 spline and use split and
;;                  elevate-degree to increase its elem and
;;                  dof counts.
;;
;; mesh-test()    = exercise ds:set-elem-count with ds_user_cstrn cstrns
;;                = incomplete test waiting for the function
;;                  to be completed
;;
;** ds-roll()      = fails
;;                   an extension of base-face with a series
;;                  of commits this function is not really designed
;;                  right because I'm confused about the rollback
;;                  mechanism.
;;
;; iter-test()    = exercise the solve convergence mechanism
;; box-test       = deform a face in a block from (pos min min min)
;; ( . min max e)   to (pos max max max) broken up into exe elems
;;                  (defaults min=5 max=25 e=3)
;;
;; box-blend-test = deform a face in a smoothed block (incomplete)
;;
;; slab-test . e  = deform a face in a slab block with a cylindrical
;;                  hole in its center. e=elem count in each dir
;;                  (default 10)
;; box-blend-test = never completed test
;;
;; spring-set     = add a spring set with 8 positions
;; spring-group   = add 8 different springs
;; scatter-group  = add spring set of n randomly generated positions.
;;  ( n . z)        z = size of z variations, (default 5).
;;
;; geomod         = a geoscience like example - (incomplete)
;;
;; corner-00      = now in dsdemo.scm
;; corner-01      = one of 4 symmetric str-cstrn test cases
;; corner-11      = one of 4 symmetric str-cstrn test cases
;; corner-10      = one of 4 symmetric str-cstrn test cases
;;
;; par-00         = now in dsdemo.scm
;; par-01         = one of 4 symmetric parabolic-cstrn test cases
;; par-11         = one of 4 symmetric parabolic-cstrn test cases
;; par-10         = one of 4 symmetric parabolic-cstrn test cases
;; par-fun        = add a different parabolic cstrn across corner
;;
;; line-hill(. n) = pinned nxn (default = 20) square draped over a
;;                  line constraint
;; circ-hill(. n) = pinned nxn (default = 20) square draped over a
;;                  circle constraint
;; cstrn-test     = exercise the cstrn calls (funtion is
;;                   very abreviated - needs to be extended)
;;
;; ds-io          = save the current face and pick to restart
;; ds-eio         = save the current edge and pick to restart
;;
;** ds-call-all    = fails
;;                  run all ds scheme extensions
;;                  currently the sequence is broken because
;;                  it is not up to date with the right arguments
;; ds-everything  = run all dsdemo and dsprob sequences as nubs and
;;                  nurbs = currently the sequence is broken because
;;                  it is not up to date with the right arguments
;; ds-run-sim     = loops forever until a keyboard interrupt
;;
;
; Some more bug history
;;
;** slab-bugtest  - still broken - fails because tolerance are too large
;; dsbug1         - works (calls exit)
;; nodsbug1       - works (calls exit)
;; dcase          - works
;; cylinder-test  = face on a cylinder - works
;; interior-test  - works
;; sphere-test    = face on a sphere - works
;** c12-bug        - still broken - HM_BULLETIN_NOT_DISTRIBUTED
;** c1-bug         - still broken - HM_BULLETIN_NOT_DISTRIBUTED
;** (clear-bug)    - still broken - HM_BULLETIN_NOT_DISTRIBUTED
;** (djourn)       - still broken - segv
;; ds001           - works
;;
;; (dsbug)         - works
;** (patch-bug1)    - bad domain pt
;; (pbug)          - works
;; (transbug)      - working
;** (crvpatch-bug)  - HM_BULLETIN_NOT_DISTRIBUTED
;**  (rmpatch-bug)   - fails assert in create_edge_array
;**  (multitag-bug) - HM_BULLETIN_NOT_DISTRIBUTED
;**  (bezier-bug)   - no perpendicular from pt to surface
;**  (curv-tag)      - HM_BULLETIN_NOT_DISTRIBUTED
;
; dsbug-spring-set-plus-curve-load  - works
; dsbug-dof-state                   - fails
; dsbug-circ-cstrn-plus-spring      - bad circ input
; dsbug-dist-press-plus-spring      - bad io
; dsbug-dscstrn                     - bad circ input
; dsbug-attractor-plus-curve        - bad circ io
; box-6bug                          - works
; elevate-mesh                      - works
; split-mesh                        - works
; extrapolate-mesh                  - works success = DS_MULTI_SURFACE_EXTRAPOLATE error
; isolate-square
;

;; SOME STUFF FOR EIGENVECTORS
; calc-eigs()           = recompute all eigenvals and vecs
; print-eigsA(. i0 i1)  = print matrix A eigenvalues i0 to i1
; plot-eigA(. i gain)   = plot default shape + gain * A eigenvector(i) in z

; print-eigsCA(. i0 i1) = print matrix CA eigenvalues i- to i1
; plot-eigCA(. i gain)  = plot default shape + gain * CA eigenvector(i) in z

; pa(eigvec eigsize)    = plot-eigA( eigvec eigsize)
; ppa()                 = print-eigsA()
; pca(eigvec eigsize)   = plot-eigCA(eigvec eigsize)
; ppca()                = print-eigsA()

;; obsolete functions
;; outline (now same as hung-square in dsdemo.scm) but use
;;          of (reset) causes memory error to show to spatial.
;; eval_check = compare DS_dsurf surface point calculations made
;;              through sums of basis functions against the
;;              ACIS surface calculations made through recursion
;; spline-sphere
;; spline-cylinder
;; spline-box
;; circ-case
;; test-face
;;

;;============================================================
;; Load the demo 
;;============================================================

(load "dsdemo.scm")

;;============================================================
;; BEGIN MESH TEST SCHEME DEFINITIONS
;;============================================================

(define (check-pinned-mesh . opt)       ; square pinned at the corners
  (let ( (n (if (not (null? opt)) (car opt) 6)) )
    (let ( (deg (if (< n 4) (- n 1) 3))
           (m (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  n))
           )
      ; execute (end) in case we are sculpting another model
      (end)
      
      ; barely interesting debug information
      (display "\n n   = ") (display n)
      (display "\n m   = ") (display m)
      (display "\n deg = ") (display deg)
      (display "\n")
      
      ; make a two face model
      ; ds-model1 and ds-model2 are faces
      ; bodies = (entity:owner ds-model1) and (entity:owner ds-model2)
      (set! ds-model1 (ds:test-face n m               ; cpt counts
                                    36 36 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    0 0               ; x0 y0
                                    0 0               ; domain min
                                    1 1))             ; domain max
      (set! ds-model2 (ds:test-face n m               ; cpt counts
                                    36 36 0           ; xyz sizes
                                    ds-rational-flag  ; rational flag
                                    deg deg           ; uv degrees
                                    36 0              ; x0 y0
                                    0  0              ; domain min
                                    1  1))            ; domain max
      ;bmt(entity:erase (entity:owner ds-model1))
      ;bmt(entity:erase (entity:owner ds-model2))
      (entity:check (solid:stitch (entity:owner ds-model1)
                                  (entity:owner ds-model2)
                                  #t ) )
      
      ;; remember all demo short cuts work on the ds-model variable.
      ;; build a deformable model for face 1 and face 2.
      (set! ds-model ds-model1)
      (ds-default-params ds-model1)
      (ds:set-default-shape ds-model 1 0) (size 5) (b) (p4) (t4) (set! ds-pt1 (pc 0.5 0.5))
      (solve)
      (set! ds-model ds-model2)
      (ds-default-params ds-model2)
      (ds:set-default-shape ds-model 1 0) (size 5) (b) (p4) (t4) (set! ds-pt1 (pc 0.5 0.5))
      (solve)
      
      ;; combine the faces into a multisurf mesh
      (ds:link-face ds-model1 ds-model2)
      
      ;; toggle redundant point constraints
      (ds:set-cstrn-state ds-model 21 0)
      (ds:set-cstrn-state ds-model 22 0)
      (solve)
      (ds:set-cstrn-state ds-model 21 1)
      (ds:set-cstrn-state ds-model 22 1)
      (solve)
      
      ;; track a point on each of the surfaces
      (ds:set-pt-xyz ds-model 11 0 (position 18 18 10)) (solve)
      (ds:set-pt-xyz ds-model 25 0 (position 54 18 10)) (solve)
      
      ;; add a distributed pressure
      (ds:add-dist-press ds-model 2 400) (solve)
      (define slide-press (ds:add-dist-press ds-model 16 -400)) (solve)
      (ds:set-mouse-slider slide-press 4000)
      
      ;; convert a point constraint into a surface normal constraint
      (ds:set-cstrn-behavior ds-model 11 "pn") (solve)
      (ds:set-cstrn-behavior ds-model 25 "pn") (solve)
      (ds:set-cstrn-behavior ds-model 11 "p")  (solve)
      
      ;; exercise different link behvaiors
      (ds:set-cstrn-behavior ds-model 4 'pll_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pll_tll) (solve)
      (ds:set-cstrn-behavior ds-model 4 'poo_tll) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pff_tll) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pll_tff) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pff_tff) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pff_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'poo_tff) (solve)
      (ds:set-cstrn-behavior ds-model 4 'poo_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pof_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pfo_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pfo_tof) (solve)
      (ds:set-cstrn-behavior ds-model 4 'plf_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pfl_too) (solve)
      (ds:set-cstrn-behavior ds-model 4 'pll_too) (solve)
      
      ;; a sequence of symmetric fixed states
      (ds:set-cstrn-behavior ds-model 4 'poo_tff) (solve)
      (ds:set-pt-xyz ds-model 11 0 (position 18 18 5)) (solve)
      
      (ds:set-cstrn-behavior ds-model 4 'pff_tff) (solve)
      (ds:set-pt-xyz ds-model 11 0 (position 18 18 10)) (solve)
      
      (ds:set-cstrn-behavior ds-model 4 'pff_too) (solve)
      (ds:set-pt-xyz ds-model 11 0 (position 18 18 5)) (solve)
      
      (ds:set-cstrn-behavior ds-model 4 'pll_too) (solve)
      
      ;; set the default shape.
      ;; This will change the shape because pressure gain will be set to 0
      (ds:set-default-shape ds-model -2 1) (solve)
      (ds:set-default-shape ds-model -2 0) (solve)
      
      )))  ;; end (check-pinned-mesh)


;;============================================================
;; BEGIN SCHEME DEFINITIONS
;;============================================================

;; define a comprehensive clean exit sequence for ds
;; needed due to bugs in rubberband deletion during
;; exit
(define (dexit) (rb:clear) (exit))

;; patch-bug2   ; resolved
(define (patch-bug2)
  (pinned-square)
  (ds:add-patch ds-model 1 2 (par-pos .5 .5)
                (par-pos .3 0)
                (par-pos 0 .3) 3)
  (ds:elevate-degree ds-model 1 1)
  (solve)
  )

;; patch-bug      ; resolved
(define (patch-bug)
  (pinned-square)
  (set! ds-dm1 (ds:add-patch ds-model 1 1
                             (par-pos .45911744427541
                                      .260302670200512)
                             (par-pos .753953433447876
                                      .798115950245734)
                             (par-pos 0 0) ; not used for shape = 1 squares
                             5) )
  (solve)
  )

(define (patch-bug3)  ; resolved
  (pinned-square)
  (set! ds-dm1 (ds:add-patch ds-model 1 1
                             (par-pos .459 .260)
                             (par-pos .754 .798)
                             (par-pos  0    0)  ; not used for shape=1 squares
                             5) )
  (solve)
  )

(define (circ-patch) ; works
  (pinned-square)
  (ds:elevate-degree ds-model 1 1)
  (ds:add-patch ds-model 1 2
                (par-pos .5 .5)
                (par-pos .3  0)
                (par-pos  0 .3) 5)
  (ds:add-pt-cstrn ds-model 1 "p" (par-pos .5 .5))
  (solve)
  )

(define (thorn-patch) ; works
  (end)
  (hinged-square)
  (ds:elevate-degree ds-model 1 1)
  ;(set! ds-model (ds:test-face
  ;                     6 6         ;; cpnt_count u and v
  ;                     36 36 0     ;; size x, y, and z
  ;                     0           ;; rational 0=NUB
  ;                     4 4         ;; degree u and v
  ;                     0 0         ;; x0 y0
  ;                     0 0 9 9))   ;; domain min(uv) and max(uv)
  ;(entity:erase ds-model)
  ;(ds:set-draw-state ds-model 1 (+ ds-draw-cstrns
  ;                                 ds-draw-loads))
  ;(define ds-pt1 (ds:add-pt-cstrn ds-model
  ;    1 "position" (par-pos 0.5 0.5)))
  (ds:set-pt-xyz ds-model ds-pt1 0
                 (position 18 18 10))
  (ds:solve ds-model)
  (define my_patch (ds:add-patch ds-model 1 1 (par-pos 0.3 0.3)
                                 (par-pos 0.5 0.5)
                                 (par-pos 0   0  ) 3))
  (define my_cc2 (ds:add-pt-cstrn ds-model
                                  1 "position" (par-pos 0.5 0.5)))
  (ds:solve ds-model)
  (ds:set-pt-xyz ds-model my_cc2 0
                 (position 18 18 36))
  (ds:solve ds-model)
  (ds:commit ds-model)
  (ds:end-sculpting ds-model)
  (view:refresh)
  (ds:mouse '())
  )

;; patch-face

(define (patch-face)
  (pinned-square 8 8)
  (ds:set-pt-xyz ds-model ds-pt1 0 (position 18 18 10))
  (ds:solve ds-model 2 1)
  (ds:solve ds-model 1 1)
  (set! ds-dm1 (ds:add-patch ds-model 1 1 (par-pos .3 .3)
                             (par-pos .5 .5)
                             (par-pos  0  0) 3))
  (set! ds-pt2 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
  (ds:solve ds-model 1 1)
  (ds:set-pt-xyz ds-model ds-pt2 0 (position 14.529 14.529 23.5))
  (ds:solve ds-model 1 1)
  (set! ds-dm2 (ds:add-patch ds-model 2 1 (par-pos .7 .3)
                             (par-pos .9 .5)
                             (par-pos  0  0) 3))
  (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
  (ds:solve ds-model 2 1)
  (ds:set-pt-xyz ds-model ds-pt3 0 (position 29.058 14.529 23.5))
  ;  (set! ds-dm2 (ds:copy-patch ds-model ds-dm1 (par-pos .4 0)))
  (ds:solve ds-model 2 1)
  ;  (ds:commit ds-model)
  ;  (ds:end-sculpting ds-model)
  ;  (ds:get-draw-state ds-model)
  ;  (view:refresh)
  )


;; patch-edge
(define (patch-edge)
  (pinned-edge 8)
  (ds:set-pt-xyz ds-model ds-pt3 0 (position 18 0 10))
  (ds:solve ds-model 2 1)
  (ds:solve ds-model 1 1)
  (set! ds-dm1 (ds:add-patch ds-model 1 1 (par-pos .3 .3)
                             (par-pos .5 .5)
                             (par-pos  0  0) 3))
  (set! ds-pt4 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
  (ds:solve ds-model 1 1)
  (ds:set-pt-xyz ds-model ds-pt4 0 (position 14.529 0 23.5))
  (ds:solve ds-model 1 1)
  (set! ds-dm2 (ds:add-patch ds-model 2 1 (par-pos .7 .7)
                             (par-pos .9 .9)
                             (par-pos  0  0) 3))
  (set! ds-pt5 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
  (ds:solve ds-model 1 1)
  (ds:set-pt-xyz ds-model ds-pt5 0 (position 29.058 0 23.5))
  ;  (set! ds-dm2 (ds:copy-patch ds-model ds-dm1 (par-pos .4 0)))
  (ds:solve ds-model 2 1)
  (set! ds-dm3 (ds:add-patch ds-model 2 1 (par-pos .0 .0)
                             (par-pos .3 .3)
                             (par-pos  0  0) 3))
  (set! ds-pt5 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
  (ds:solve ds-model 1 1)
  (ds:set-pt-xyz ds-model ds-pt5 0 (position 5.400 0 23.5))
  (ds:solve ds-model 2 1)
  (ds:commit ds-model)
  (ds:end-sculpting ds-model)
  (ds:get-draw-state ds-model)
  (ds:set-comb-graphics ds-model -2 25 -100)
  (ds:set-draw-state ds-model -2 (+ ds-draw-cstrns
                                    ds-draw-loads))
  (ds:set-draw-state ds-model 2 (+ ds-draw-seams
                                   ds-draw-cstrns
                                   ds-draw-loads
                                   ds-draw-curve-comb))
  
  (view:refresh)
  )

;; patch-circ
;(define (patch-circ)
;  (pinned-square 8 8)
;  (ds:set-pt-xyz ds-model ds-pt1 0 (position 18 18 10))
;  (ds:solve ds-model 2 1)
;  (ds:solve ds-model 1 1)
;  (set! ds-dm1 (ds:add-patch ds-model 1 2 (par-pos .3 .3)
;                                          (par-pos .0 .2)
;                                          (par-pos .2 .0) 3))
;  (set! ds-pt2 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
;  (ds:set-pt-xyz ds-model ds-pt2 0 (position 14.529 14.529 23.5))
;  (ds:solve ds-model 1 1)
;  (set! ds-dm2 (ds:add-patch ds-model 2 2 (par-pos .7 .3)
;                                          (par-pos .2 .0)
;                                          (par-pos .0 .2) 3))
;  (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
;  (ds:set-pt-xyz ds-model ds-pt3 0 (position 29.058 14.529 23.5))
;;  (set! ds-dm2 (ds:copy-patch ds-model ds-dm1 (par-pos .4 0)))
;  (ds:solve ds-model 2 1)
;;  (ds:commit ds-model)
;  (ds:end-sculpting ds-model)
;  (ds:get-draw-state ds-model)
;  (view:refresh)
;)

;; copy-patch-face
;(define (copy-patch-face)
;  (pinned-square 8 8)
;  (ds:set-pt-xyz ds-model ds-pt1 0 (position 18 18 10))
;  (ds:solve ds-model 2 1)
;  (ds:solve ds-model 1 1)
;  (set! ds-dm1 (ds:add-patch ds-model 1 1 (par-pos .3 .3)
;                                          (par-pos .5 .5)
;                                          (par-pos  0  0) 3))
;  (set! ds-pt2 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
;  (ds:set-pt-xyz ds-model ds-pt2 0 (position 14.529 14.529 23.5))
;  (ds:solve ds-model 1 1)
;  (set! ds-dm2 (ds:add-patch ds-model 2 1 (par-pos .7 .3)
;                                          (par-pos .9 .5)
;                                          (par-pos  0  0) 3))
;  (set! ds-pt3 (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5)))
;  (ds:set-pt-xyz ds-model ds-pt3 0 (position 29.058 14.529 23.5))
;   (set! ds-dm2 (ds:copy-patch ds-model ds-dm1 (par-pos .4 0)))
;  (ds:solve ds-model 2 1)
;  (ds:commit ds-model)
;  (ds:end-sculpting ds-model)
;  (ds:get-draw-state ds-model)
;  (view:refresh)
;)

;; refacet( . e) = sequence to force the graphical update of the
;;                 ENTITY face owner of the deformable surface
(define (refacet . opt)
  ( let ((tgt (if (not (null? opt)) (car opt) ds-model)))
    (display "refacet ") (display tgt)
    (roll:mark-start)
    ;bmt(entity:erase tgt)
    (entity:delete-facets tgt)
    (display ": ") (display (entity:facet tgt)) (display " facets")
    (entity:display tgt)
    (roll:mark-end)
    (display "\n")
    ))

;; part load and save test sequences

;; extend the commit sequences with part save and load sequences
;; (save cm)  = an extension of the cm commands to include save and
;;              load sequences.  Argument cm is one of cm0, cm1, cm2
;;              cm3, cm4, cm5, or cm6

(define (save cm)
  (display "save ")
  (part:clear)
  (set! ds-model '())
  (cm)
  (if (entity:displayed? ds-model)
      (display "ds-model displayed\n")
      (display "ds-model not displayed\n"))
  (display "saving part\n")
  (part:save "temp.tmp")
  (part:clear)
  (display "retrieving part\n")
  (set! ds-entity-list (part:load "temp.tmp"))
  (if (not (null? (entity:faces (car ds-entity-list))))
      (set! ds-model (car (entity:faces (car ds-entity-list))))
      (set! ds-model (car (entity:edges (car ds-entity-list)))))
  ;bmt(entity:erase ds-model)
  (ds:mouse ds-model #f)
  (solve) (ds:get-tag-summary ds-model)
  )

;; sequences to test commit-to-owner
;; sequences cm0 to cm5 are accumulative that is cm5 is a superset
;; of cm0.  Once cm5 is running no need to run cm0 to cm4.

;; cm0 = no tag objects
;; cm1 = added pt and crv cstrn objects
;; cm2 = added distributed pressures
;; cm3 = added spring load
;; cm4 = added curve load
;; cm5 = added multiples of above
;; cm6 = added deletes and multiple commits
(define (cm0) (display "cm0\n")
  (clear)
  (dface 6 6)
  (let ((this-face ds-model))
    (b) (solve 2 3)
    (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm1)  (display "cm1\n")
  (clear)
  (dface 6 6)
  (let ((this-face ds-model))
    (b) (pc 0.5 0.5) (cc .1 .1 .1 .8)
    (solve 2 3) (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm2)  (display "cm2\n")
  (clear)
  (dface 6 6)
  (let ((this-face ds-model))
    (b) (pc 0.5 0.5) (cc .1 .1 .1 .8)
    (pp 0.4 0.4) (dp) (dp 0  0 0   .3 1)
    (solve 2 3) (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm3)  (display "cm3\n")
  (clear)
  (dface 6 6)
  (let ((this-face ds-model))
    (b) (pc 0.5 0.5) (cc .1 .1 .1 .8)
    (pp 0.4 0.4) (dp) (dp 0   0 0   .3 1) (spr .7 .7)
    (solve 2 3) (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm4)  (display "cm4\n")
  (clear)
  (dface 6 6)
  (let ((this-face ds-model))
    (b) (pc 0.5 0.5) (cc .1 .1 .1 .8)
    (pp 0.4 0.4) (dp) (dp 0  0 0  .3 1)
    (cl .8 .1 .8 .8) (cir-load .5 .5 .3) (spr .7 .7)
    (solve 2 3) (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm5)  (display "cm5\n")
  (clear)
  (dface 9 9)
  (let ((this-face ds-model))
    (b)
    (pc 0.5 0.5) (pc 0.0 0.0) (pc 1.0 1.0)
    (cc .1 .1 .1 .9) (cc .2 .2 .2 .9) (cc .3 .3 .3 .9)
    (pp 0.4 0.4) (pp 0.7 0.4) (pp 0.9 0.4) (dp)
    (dp 0   0 0   .3 1)
    (cl .8 .2 .8 .8) (cl .8 .8 .2 .8) (cl .2 .8 .2 .2) (cl .2 .2 .8 .2)
    (cir-load .5 .5 .3) (spr .7 .7) (spr .7 .4) (spr .7 .1)
    (solve 2 3) (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model) )
  )
(define (cm6)  (display "cm6\n")
  (clear)
  (dface 9 9)  (b)
  (let ((this-face ds-model)
        (t1 (pc 0.0 0.0))     (t2 (pc 1.0 1.0))
        (t3 (cc .1 .1 .1 .9)) (t4 (cc .2 .2 .2 .9)) (t5 (cc .3 .3 .3 .9))
        (t6 (pp 0.7 0.4))     (t7 (pp 0.9 0.4))
        (t8 (spr .7 .4))       (t9 (spr .7 .1))
        (t10 (cl .2 .2 .8 .8)))
    (pc 0.5 0.5) (pp 0.4 0.4) (dp)
    (dp 0   0 0   .3 1)
    (cl .8 .2 .8 .8) (cl .8 .8 .2 .8) (cl .2 .8 .2 .2) (cl .2 .2 .8 .2)
    (cir-load .5 .5 .3) (spr .7 .7)
    (solve 2 3) (commit)
    (delete t1) (delete t2) (delete t3) (delete t4) (delete t5)
    (delete t6) (delete t7) (delete t8) (delete t9) (delete t10)
    (ds:get-tag-summary ds-model) (commit) (end)
    (set! ds-model this-face)  (a) (solve)
    (ds:get-tag-summary ds-model)
    (spr .9 .3) (spr .3 .5) (end) (set! ds-model this-face)
    (a) (solve) (ds:get-tag-summary ds-model)
    ))

;; interesting patterns of curve-loads
;; cross = a curve load x in the center of a square
;; outline = a centered box of psrings within a square

(define (cross)
  (display "cross\n")
  (dface 6 6) (ds:set-default-shape ds-model 1 0)
  (t4)
  (p4)
  (set! ds-cload1 (cl .2 .2 .8 .8))
  (set! ds-cload2 (cl .2 .8 .8 .2))
  (gain ds-cload1 1000)
  (gain ds-cload2 1000)
  (set! ds-cpt (pc .5 .5))
  (ds:set-pt-xyz ds-model ds-cpt 0 (position 18 18 10))
  (solve 2 4))

;; base case for split and elevate-degree tests
;; build a degree one spline for a square face
;; base-face = create a simple spline and use split and
;;             elevate-degree to increase its dof count
(define (base-face)
  (display "base-face\n")
  (end)
  (set! ds-model                        ; make NUB face
        (ds:test-face 2 2               ; ucpt_count, vcpt_count
                      36 36 0           ; x_size, y_size, z_size
                      ds-rational-flag  ; rational_flag
                      1 1))             ; degree_u degree_v
  ; rational, u_degree, v_degree
  ;bmt(entity:erase ds-model)
  (ds:mouse ds-model #f)
  (draw (+ 1 4 8 32))
  (inc-degree)
  (inc-degree)
  (split .5 .5 1)
  (solve)
  )

;; exercise ds:set-elem-count with a ds-user-curve crv_cstrn
(define (mesh-test) ; still incomplete
  (circ1-cstrn)  (e)
  (ds:set-pt-xyz ds-model 11 0 (position 18 18 8))
  (mesh 7 7 1)      ; the ds:set-elem-count call
  )

;; extension of base-face to test rollback
(define (ds-roll)
  (display "ds-roll\n")
  (base-face)
  (display "commit0\n")
  (roll:name-state "commit0")
  (commit)
  (display "commit1\n")
  (roll:name-state "commit1")
  (set! ds-cc1 (pc .5 .5))
  (sxyz ds-cc1 18 18 10)
  (commit)
  (display "commit2\n")
  (roll:name-state "commit2")
  (sxyz ds-cc1 18 18 25)
  (commit)
  (display "commit3\n")
  (roll:name-state "commit3")
  (display "roll commit0\n") (roll "commit0") (refacet)
  (display "roll commit1\n") (roll "commit1") (refacet)
  (display "roll commit2\n") (roll "commit2") (refacet)
  (display "roll commit3\n") (roll "commit3") (refacet)
  
  (display "roll commit2\n") (roll "commit2") (refacet)
  (display "roll commit0\n") (roll "commit0") (refacet)
  (display "roll commit3\n") (roll "commit3") (refacet)
  (display "roll commit1\n") (roll "commit1") (refacet)
  
  (define tmodel ds-model)
  (ds:mouse '())
  (set! ds-model tmodel)
  (display "try (roll 'commit0) (refacet)\n") ;
  (display "try (roll 'commit1) (refacet)\n") ;
  (display "try (roll 'commit2) (refacet)\n") ;
  (display "try (roll 'commit3) (refacet)\n") ;
  )

;; exercise the solve convergence mechanism
(define (iter-test)
  (pinned-square)
  (size 5)
  (toggle 11)
  (dp)
  (ds:set-load-gain ds-model 12 10000)
  (solve -1)
  )

;; box-test = deform a face in a block
(define (box-test . opt) ; opt = (min_pt max_pt elem_count)
  (let ((n (if (not (null? opt))
               (car   opt)  5))
        (m (if (not (or (null? opt) (null? (cdr opt))))
               (cadr  opt) 25))
        (e (if (not (or (null? opt) (null? (cdr opt)) (null? (cddr opt))))
               (caddr opt)  3)))
    (display "box-test\n")
    (clear)
    (set! ds-block (solid:block (position n n n) (position m m m)))
    (ds-pick e)
    (set! ds-cc1 (pc .5 .5))))

(define (slab-test . opt)  ; opt = number of elems in each direction
  (let ((n (if (not (null? opt)) (car opt) 10))
        (tmp-face '()))
    (display "slab-test\n  building slab model . ")
    (clear)
    (display ". ")
    (set! ds-block (solid:block (position  0  0  0)
                                (position 44 34 10)))
    (display ". ")
    (set! ds-block (solid:subtract ds-block
                                   (solid:cylinder (position 22 17 -2)
                                                   (position 22 17 12)
                                                   5)))
    (display ". ")
    ;  (debug:file "slabtst0.dbg")
    ;  (entity:debug ds-block 4)
    ;  (debug:file "stdout")
    ;  (entity:delete ds-block) (display ". ")
    
    ;; hard-code the editing of face 3 1 instead of picking
    (display "\n")(ds-pick n)
    ;; (set! ds-model (entity 3 1))
    ;; (cond ((= 1 (car (ds:get-elem-count ds-model 1)))
    ;;        (display "  Splitting face into elems \n")
    ;;        (do ((i 1 (+ i 1))) ((= i n))
    ;;           (set! a (append a (list (par-pos (* i del)(* i del)))))
    ;;                  )
    ;;        (ds:split-domain ds-model 1 a)))
    ;;
    ;; ; Use globals to bind this face to mouse and demo funcs
    ;; (ds:mouse ds-model)
    ;;
    ;; ; change graphics to show elems
    ;; (e)
    ;; (view:refresh)
    
    ;(define ds-model (pick:face (ray (position 0 0 0) (gvector 0 0 1))))
    (set! tmp-face ds-model)
    ;bmt(entity:erase ds-block)
    (set! ds-dp1 (dp 0))
    (ds:set-mouse-slider ds-dp1 200000)
    (gain ds-dp1 100000)
    (display " - building and solving deformed shape equations - ")
    (solve 2 2)
    (display "\n - commit, end, and refacet - ")
    (commit)
    (end)
    
    (entity:check ds-block)
    (set! ds-model tmp-face)
    (ds:mouse ds-model)
    (display "\n - restart sculpting - ")
    
    (e)
    (solve)
    (ds:get-tag-summary ds-model 1)
    (display "\n - increase pressure load - ")
    (gain ds-dp1 50000)
    (solve)
    (display "\n - commit, end, and refacet - ")
    (commit)
    (end)
    ; (refacet ds-block) ;; now a part of ds:commit
    (entity:check ds-block)
    
    (solid:subtract ds-block (solid:cylinder
                               (position 0 -10 10) (position 0 40 10) 5))
    (entity:check ds-block)
    ;    (set! ds-model tmp-face)
    ;    (ds:mouse ds-model)
    ;    (display "\n - begin sculpting of modified body - ")
    ;    (e)
    ;    (solve 2 3)
    ;    (ds:get-tag-summary ds-model 1)
    ;    (display "\n - decrease pressure load - ")
    ;    (gain ds-dp1 -100)
    ;    (solve 2 3)
    ;    (display "\n - commit, end, and refacet - ")
    ;    (commit)
    ;    (end)
    ;    ; (refacet ds-block)  ;; now a part of ds:commit
    ;    (entity:check ds-block)
    ;
    ;  (debug:file "slabtst1.dbg")
    ;  (entity:debug ds-block 4)
    ;  (debug:file "stdout")
    ;  (display "done - Try (gain ds-dp1 200)\n")
    
    )) ; end slab-test

;;  box-blend-test = deform a face in a smoothed block
(define (box-blend-test) ; never completed - not working
  (display "box-blend-test\n")
  (clear)
  (set! ds-block (solid:block (position 5 5 5) (position 25 25 25)))
  (blend:const-rad-on-edge (entity 8) 4)
  (blend:network (blend:get-network (entity 8)))
  (ds-pick)
  (b)
  (ds:split-domain ds-model 1 (list (par-pos .3333 .3333)
                                    (par-pos .6666 .6666)))
  (set! ccl (pc .5 .5)))


;; sequence to exercise the spring-set command
(define (spring-set)
  (display "spring-set\n")
  (dface 6 6) (ds:set-default-shape ds-model 1 0) (t4)
  (set! ds-spr (ds:add-spring-set ds-model 1
                                  (list (position  0  0 3)
                                        (position 36 36 7)
                                        (position  0 36 -1)
                                        (position 36  0 4)
                                        (position 18 18 6)
                                        (position  7 29 3)
                                        (position 25 22 -1)
                                        (position 29  7 1)) 200))
  (solve)
  )
;; sequence to exercise the spring command
(define (spring-group)
  (display "spring-group\n")
  (dface 6 6) (ds:set-default-shape ds-model 1 0) (t4)
  (ds:add-spring ds-model 1 (par-pos .05 .05)   (position  0  0 3) 200)
  (ds:add-spring ds-model 1 (par-pos .95 .95)   (position 36 36 7) 200)
  (ds:add-spring ds-model 1 (par-pos .05 .95)   (position  0 36 -1) 200)
  (ds:add-spring ds-model 1 (par-pos .95 .05)   (position 36  0 4) 200)
  (ds:add-spring ds-model 1 (par-pos .50 .50)   (position 18 18 6) 200)
  (ds:add-spring ds-model 1 (par-pos .225 .775) (position  7 29 3) 200)
  (ds:add-spring ds-model 1 (par-pos .675 .600) (position 25 22 -1) 200)
  (ds:add-spring ds-model 1 (par-pos .775 .075) (position 29  7 1) 200)
  (solve)
  )

;; scatter-group
(define (scatter-group pt_count . opt)  ;  opt = elem_count z displacement
  (display "scatter-group\n")
  (if (not (null? opt))
      (dface (car opt) (car opt))
      (dface 9 9) )
  (ds:set-default-shape ds-model 1 0) (t4)
  (if (not (null? (cadr opt)))
      (set! ds-spr (ds:add-spring-set ds-model 1
                                      (ds:test-scatter pt_count 36 36 (cadr opt)) 5000))
      (set! ds-spr (ds:add-spring-set ds-model 1
                                      (ds:test-scatter pt_count) 5000)))
  (display "\n Spring-set Tag = ") (display ds-spr) (display "\n")
  (display " Try gain changes with (gain ")
  (display ds-spr) (display " gain_val)\n")
  (display " Try data changes with (scatter-group pt_count z-hgt)\n") ;
  )

;; geoscience like example
;(define (geomod salt1 salt2 horizon1)
;  (let ( (sheet1 '()) (sheet2 '()) (salt '()) (mod '()) )
;   (display "geomod\n")
;   (set! sheet1 (sheet:face salt1))
;   (set! sheet2 (sheet:face salt2))
;   (set! sheet1 (sheet:2d sheet1))
;   (set! sheet2 (sheet:2d sheet2))
;   (set! salt (bool:union sheet1 sheet2))
;   (set! salt (sheet:enclose-void salt))
;   (set! salt (bool:regularize salt))
;   (set! mod (bool:nonregularized-union
;              salt
;              (bool:subtract horizon1 (part:copy salt))))
;))

;; simple internal curve-constraint test cases
;; that test for symmetric solutions
;; these cases all build the same problem but rotated through
;; 90 degrees the solutions should also look rotated by 90 degrees

;; corner-01 = add straight constraint across corner 2
;; corner-11 = add straight constraint across corner 3
;; corner-10 = add straight constraint across corner 4

;; par-01 = add parabolic constraint across corner 2
;; par-11 = add parabolic constraint across corner 3
;; par-10 = add parabolic constraint across corner 4
;; par-fun= add a different parabolic constraint across corner


(define (corner-01)
  (display "corner-01\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 8)  (cc 0.5 1.0 0 0.5) (pc 0.5 0.5)
  )

(define (corner-11)
  (display "corner-11\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 9) (cc 1.0 0.5 0.5 1.0) (pc 0.5 0.5)
  )

(define (corner-10)
  (display "corner-10\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 10) (cc 0.5 0 1.0 0.5) (pc 0.5 0.5)
  )

(define (par-01)
  (display "par-01\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 8)
  (set! ds-cc1 (ds:add-parab-cstrn ds-model 1 "position"
                                   (par-pos 0 0.3)
                                   (par-pos 0 1.0)
                                   (par-pos 0.7 1.0) ))
  (pc 0.5 0.5))

(define (par-11)
  (display "par-11\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 9)
  (set! ds-cc1 (ds:add-parab-cstrn ds-model 1 "position"
                                   (par-pos 0.3 1.0)
                                   (par-pos 1.0 1.0)
                                   (par-pos 1.0 0.3) ))
  (pc 0.5 0.5))

(define (par-10)
  (display "par-10\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 10)
  (set! ds-cc1 (ds:add-parab-cstrn ds-model 1 "position"
                                   (par-pos 0.3 0.0)
                                   (par-pos 1.0 0)
                                   (par-pos 1.0 0.7) ))
  (pc 0.5 0.5))

(define (par-fun)
  (display "par-fun\n")
  (dface 6 6)
  (ds:set-default-shape ds-model 1 0) (p4) (t4) (solve)
  (toggle 10)
  (set! ds-cc1 (ds:add-parab-cstrn ds-model 1 "position"
                                   (par-pos 0.7 1.0)
                                   (par-pos 1.0 0)
                                   (par-pos 0 0.3) ))
  (pc 0.5 0.5))
; XXX Corp. motivated examples.  Run on a fast machine
; because they default to large dof counts.

(define (line-hill . opt)
  (let ((n (if (not (null? opt)) (car opt) 20)))
    (pinned-square n) (solve) (t4)
    (sxyz ds-pt1 15 21 12) (solve) (e)
    (cc .2 .2 .8 .8) (beta 0) (ds:set-mouse-slider (dp 0) 300)(solve)))

(define (circ-hill . opt)
  (let ((n (if (not (null? opt)) (car opt) 20))
        (pgain -50))
    (pinned-square n) (solve) (t4)
    (sxyz ds-pt1 18 18 10) (solve) (e)
    (cir-cstrn .5 .5 .2) (beta 0) (toggle ds-pt1)
    (solve 2 3)
    (dp pgain    0  0   .3  1)
    (dp pgain   .7  0    1  1)
    (dp pgain   .3  0   .7 .3)
    (dp pgain   .3 .7   .7  1)
    (solve)))

(define (cstrn-test)
  (pinned-square 10 10)
  (ds:add-cstrn ds-model 1 "point"    "position" (par-pos .2 .2))
  (ds:add-cstrn ds-model 1 "point"    "normal"  (par-pos .4 .2))
  (ds:add-cstrn ds-model 1 "point"    "pos_norm"  (par-pos .6 .2))
  
  (ds:add-cstrn ds-model 1 "straight" "position" (par-pos .2 .3)
                (par-pos .5 .6))
  (ds:add-cstrn ds-model 1 "parabola" "position" (par-pos .4 .3)
                (par-pos .8 .8)
                (par-pos .9 .3))
  (ds:add-cstrn ds-model 1 "circ"     "position" (par-pos .6 .5)
                (par-pos .1 .0)
                (par-pos .0 .1))
  )

(define (ds-io)    ; exercise commit,end,and pick face
  (commit) (end) (ds:pick-face))

(define (ds-eio)   ; exercise commit,end,and pick edge
  (commit) (end) (ds:pick-edge))

(define (ds-aio)  ; exercise commit,end,and start without pick
  (let ((this-model '()))
    (set! this-model ds-model) (commit) (end) (rbd:clear)
    (set! ds-model this-model) (ds:mouse ds-model)
    ;bmt(entity:erase ds-model) (tags) (view:refresh)
    ))

;; ds-call-all   - call all ds scheme extensions
(define (ds-call-all)
  (let ((load '())
        (cstrn '())
        )
    (pinned-square)
    (ds:get-tag-type ds-model 1)
    (ds:get-dynamics ds-model 1)
    (ds:get-dof-state ds-model 1)
    (ds:get-draw-grid ds-model 1)
    (ds:get-end-conds ds-model 1)
    (ds:get-tag-patch ds-model 11)
    (ds:get-elem-count ds-model 1)
    (ds:get-draw-state ds-model 1)
    (ds:get-icon-radius ds-model)
    (ds:get-shape-knots ds-model 1)
    (ds:get-tag-summary ds-model 1)
    (ds:get-shape-degree ds-model 1)
    (ds:get-active-patch ds-model )
    (ds:get-mouse-slider)
    (ds:get-comb-graphics ds-model 1)
    (ds:get-default-state ds-model 1)
    (ds:get-shape-degree ds-model 1)
    (ds:get-integral-degree ds-model 1)
    (ds:get-pt-xyz ds-model 11)
    (ds:get-pt-uv  ds-model 11)
    (ds:get-xyz    ds-model 1 (par-pos .5 .5))
    (ds:get-cstrn ds-model 11)
    (ds:get-beta ds-model 1)
    (ds:get-delta ds-model 1)
    (ds:get-alpha ds-model 1)
    
    (set! load (ds:add-dist-press ds-model 1 100))
    (ds:solve ds-model 1)
    (ds:set-load-gain ds-model load 200)
    (ds:get-load-gain ds-model load)
    (ds:solve ds-model)
    (ds:rm-tag-object ds-model load) (ds:solve ds-model)
    
    (set! load (ds:add-pt-press ds-model 1 (par-pos .5 .5) 100))
    (ds:solve ds-model)
    (ds:get-pt-xyz ds-model load)
    (ds:get-tag-type ds-model load)
    (ds:get-load-gain ds-model load)
    (ds:get-pt-uv ds-model load)
    (ds:set-pt-uv ds-model load (par-pos .6 .6)) (ds:solve ds-model)
    (ds:rm-tag-object ds-model load) (ds:solve ds-model)
    
    (set! load (ds:add-spring ds-model 1 (par-pos 0.5 0.5) 100))
    (ds:solve ds-model)
    ; (ds:get-slide-state ds-model load)
    (ds:get-spring-length ds-model load)
    ;    (ds:set-slide-state ds-model load 0) (ds:solve ds-model)
    ;    (ds:set-slide-state ds-model load 1) (ds:solve ds-model)
    (ds:rm-tag-object ds-model load) (ds:solve ds-model)
    
    (set! cstrn (ds:add-pt-cstrn ds-model 1 "position" (par-pos .25 .25)))
    (ds:solve ds-model)
    (ds:get-pt-xyz ds-model cstrn 0)
    (ds:get-pt-xyz ds-model cstrn 4)
    (ds:set-pt-xyz ds-model cstrn 0 (position 5 5 5)) (ds:solve ds-model)
    (ds:toggle-cstrn ds-model cstrn) (ds:solve ds-model)
    (ds:toggle-cstrn ds-model cstrn) (ds:solve ds-model)
    (ds:rm-tag-object ds-model cstrn) (ds:solve ds-model)
    
    (set! load (ds:add-spring-set ds-model 1 (list (position .25 .25 .25)
                                                   (position .50 .50 .50)
                                                   (position .75 .75 .75)) 100))
    (ds:solve ds-model)
    (ds:rm-tag-object ds-model load) (ds:solve ds-model)
    
    (cond ((face? ds-model)
           (set! load (ds:add-str-load ds-model 1 (par-pos .2 .2)
                                       (par-pos .6 .6)))
           (ds:solve ds-model)
           (ds:rm-tag-object ds-model load) (ds:solve ds-model)
           
           ; (set! load (ds:add-circ-load ds-model 1 (par-pos 0.5 0.5)
           ;                              (par-pos 0.2 0.0)
           ;                              (par-pos 0.0 0.3)))
           ; (ds:solve ds-model)
           ; (ds:rm-tag-object ds-model load) (ds:solve ds-model)
           (set! cstrn (ds:add-str-cstrn ds-model 1 "position"
                                         (par-pos .2 .2)
                                         (par-pos .6 .6)))
           (ds:solve ds-model)
           (ds:rm-tag-object ds-model cstrn) (ds:solve ds-model)
           (set! cstrn (ds:add-circ-cstrn ds-model 1 "position"
                                          (par-pos 0.5 0.5)
                                          (par-pos 0.2 0.0)
                                          (par-pos 0.0 0.3)))
           (ds:solve ds-model)
           ; (set! load (ds:crv-load-from-cstrn ds-model cstrn))
           ; (ds:solve ds-model)
           ; (ds:rm-tag-object ds-model cstrn)
           ; (ds:rm-tag-object ds-model load) (ds:solve ds-model)
           (set! load (ds:add-parab-load ds-model 1 (par-pos .2 .2)
                                         (par-pos .5 .5)
                                         (par-pos .8 .2)))
           (ds:solve ds-model)
           (set! cstrn (ds:crv-cstrn-from-load ds-model load))
           (ds:solve ds-model)
           (ds:rm-tag-object ds-model cstrn) (ds:solve ds-model)
           (set! load (ds:add-parab-cstrn ds-model 1 "position"
                                          (par-pos .2 .2)
                                          (par-pos .5 .5)
                                          (par-pos .8 .2)))
           (ds:solve ds-model)
           (ds:rm-tag-object ds-model load) (ds:solve ds-model)
           (set! load (ds:add-spring-curve ds-model 1 (par-pos .2 .2)
                                           (par-pos .8 .8)
                                           (position 0 0 0)
                                           (position 9 9 9)))
           (ds:solve ds-model)
           (ds:rm-tag-object ds-model load) (ds:solve ds-model)
           
           )) ;; end is ds-model a face check
    
    (ds:debug ds-model 1)
    
    (ds:extrapolate ds-model 1) (ds:solve ds-model)
    (ds:elevate-degree ds-model 1)
    
    (ds:mouse-view-help)
    (ds:mouse ds-model)
    (ds:mouse-help)
    
    (cond ((not (null? (env:active-view)))
           (ds:pick-par-pos ds-model (event 100 100 1 (env:active-view)))
           (ds:pick-tag-id ds-model (event 100 100 1 (env:active-view)))
           )) ; // end is there an active view check
    
    (ds:split-domain ds-model 1 (list (par-pos 0.67832 0.67382)))
    
    (ds:set-draw-state ds-model 1 (ds:get-draw-state ds-model 1))
    (ds:set-icon-radius ds-model (ds:get-icon-radius ds-model))
    
    (ds:set-mouse-slider 5 100)
    (ds:set-comb-graphics ds-model 1 10 2.0)
    
    (ds:set-default-shape ds-model 1 1) (ds:solve ds-model)
    (ds:set-default-shape ds-model 1 0) (ds:solve ds-model)
    (ds:set-integral-degree ds-model 9)
    
    (ds:set-delta ds-model 1 1) (ds:solve ds-model)
    (ds:set-delta ds-model 1 0) (ds:solve ds-model)
    
    (cond ((face? ds-model)
           (ds:set-draw-grid ds-model 1 (car  (ds:get-draw-grid ds-model 1))
                             (cadr (ds:get-draw-grid ds-model 1)))
           (ds:set-end-conds ds-model 1 0 2 0) (ds:solve ds-model)
           (ds:set-end-conds ds-model 0 0 0 0) (ds:solve ds-model)
           (ds:set-alpha ds-model 1 4 4 1.5)     (ds:solve ds-model)
           (ds:set-beta ds-model 1 10 10 -1.5)   (ds:solve ds-model)
           ; (ds:set-elem-count ds-model 1 6 6)
           
           ) ; // end is ds-model a face check
          ((edge? ds-model)
           (ds:set-draw-grid ds-model 1 (car  (ds:get-draw-grid ds-model 1)))
           (ds:set-end-conds ds-model 1 )   (ds:solve ds-model)
           (ds:set-end-conds ds-model 0 )   (ds:solve ds-model)
           (ds:set-alpha ds-model 1 4)        (ds:solve ds-model)
           (ds:set-beta ds-model 1 10)        (ds:solve ds-model)
           ; (ds:set-elem-count ds-model 1 8)
           
           ) ; // end is ds-model an edge check
          ) ; // end cond branch on face/edge
    
    
    ;; the following 3 commands are not run because they build test cases
    ;; they are not functions
    ; (ds:test-scatter)
    ; (ds:test-edge)
    ; (ds:test-face)
    
    (ds:end-sculpting ds-model) (ds:solve ds-model)
    
    (ds:commit ds-model)
    
    ; and interactive command
    ; (ds:select-face)
    (display "\n Finished ds-call-all\n")
    
    ))

;; ds-everything - exercise all of dsdemo.scm
(define (ds-everything)
  (do-nubs)
  (pinned-square)   (solve) (hinged-square)   (solve) (hung-square) (solve)
  (folding-square)  (solve) (corner-00)       (solve) (par-00)      (solve)
  (circ1-cstrn)     (solve) (circ2-cstrn)     (solve) (circ1-load)  (solve)
  (circ2-load)      (solve) (hinged-circ)     (solve)
  (pinned-square)   (solve) (alpha 1) (alpha 1 2) (beta 1) (beta 1 2)
  (delta 1)
  (ds:set-default-shape ds-model 1 1) (dyn .1 10 2) (solve)
  (dp4) (su0) (solve) (su1) (solve) (su2) (solve) (su3) (solve) (su0) (sv1) (solve)
  (sv2) (solve) (sv3) (solve) (sv0) (solve) (t4)(solve) (t4) (solve)
  (p4) (solve) (conv 1) (solve)
  (refacet)         (solve)
  (save cm5)        (solve)  (clear)
  (cross)       (solve)
  (base-face)       (solve)
  (ds-roll)         (solve)
  (spring-set)        (solve)    (spring-group)    (solve) (scatter-group 35 25) (solve)
  (corner-01)       (solve) (corner-11)       (solve) (corner-10)   (solve)
  (par-01)            (solve) (par-11)          (solve) (par-10)        (solve)
  (par-fun)            (solve) (line-hill)       (solve) (circ-hill)   (solve)
  (clear) (goblet)            (solve)
  (do-nurbs)
  (pinned-square)   (solve) (hinged-square)   (solve) (hung-square) (solve)
  (folding-square)  (solve) (corner-00)       (solve) (par-00)      (solve)
  (circ1-cstrn)     (solve) (circ2-cstrn)     (solve) (circ1-load)  (solve)
  (circ2-load)      (solve) (hinged-circ)     (solve)
  (pinned-square)   (solve) (alpha 1) (alpha 1 2) (beta 1) (beta 1 2)
  (delta 1)
  (ds:set-default-shape ds-model 1 1) (dyn .1 10 2) (solve)
  (dp4) (su0) (solve) (su1) (solve) (su2) (solve) (su3) (solve) (su0) (sv1) (solve)
  (sv2) (solve) (sv3) (solve) (sv0) (solve) (t4)(solve) (t4) (solve)
  (p4) (solve) (conv 1) (solve)
  (refacet)         (solve)
  (save cm5)        (solve)  (clear)
  (cross)       (solve)
  (base-face)       (solve)
  (ds-roll)         (solve)
  (spring-set)        (solve)    (spring-group)    (solve) (scatter-group 35 25) (solve)
  (corner-01)       (solve) (corner-11)       (solve) (corner-10)   (solve)
  (par-01)            (solve) (par-11)          (solve) (par-10)        (solve)
  (par-fun)            (solve) (line-hill)       (solve) (circ-hill)   (solve)
  (clear) (goblet)            (solve)
  )

(define (ds-run-sim)
  (set! ds-sim-count 0)
  (ds:mouse ds-model)
  (display "\n\n\n The ONLY way to STOP")
  (display "\n PRESS <ctrl-right-mouse>\n")
  (do ((ii 0))
      ((= ds-sim-count 1000) (set! ds-sim-count 0) ds-sim-count)
      (if (= ds-sim-count 1001) (return ii))
      (ds:solve ds-model)
      ;(set! ds-sim-count (+ ds-sim-count 1))
      
      ;(display "\n (ds-sim-count) = ")
      ;(display ds-sim-count )
      ))


; still broken
(define (slab-bugtest . opt)  ; opt = number of elems in each direction
  (let ((n (if (not (null? opt)) (car opt) 10))
        (tmp-face '()))
    (display "slab-test\n  building slab model . ")
    (clear)
    (display ". ")
    (set! ds-block (solid:block (position  0  0  0)
                                (position 44 34 10)))
    (display ". ")
    (set! ds-block (solid:subtract ds-block
                                   (solid:cylinder (position 22 17 -2)
                                                   (position 22 17 12)
                                                   5)))
    (display ". ")
    ;  (debug:file "slabtst0.dbg")
    ;  (entity:debug ds-block 4)
    ;  (debug:file "stdout")
    ;  (entity:delete ds-block) (display ". ")
    
    ;; hard-code the editing of face 3 1 instead of picking
    (display "\n")(ds-pick n)
    ;; (set! ds-model (entity 3 1))
    ;; (cond ((= 1 (car (ds:get-elem-count ds-model 1)))
    ;;        (display "  Splitting face into elems \n")
    ;;        (do ((i 1 (+ i 1))) ((= i n))
    ;;           (set! a (append a (list (par-pos (* i del)(* i del)))))
    ;;                  )
    ;;        (ds:split-domain ds-model 1 a)))
    ;;
    ;; ; Use globals to bind this face to mouse and demo funcs
    ;; (ds:mouse ds-model)
    ;;
    ;; ; change graphics to show elems
    ;; (e)
    ;; (view:refresh)
    
    ;(define ds-model (pick:face (ray (position 0 0 0) (gvector 0 0 1))))
    (set! tmp-face ds-model)
    ;bmt(entity:erase ds-block)
    (set! ds-dp1 (dp 0))
    (ds:set-mouse-slider ds-dp1 600)
    (gain ds-dp1 300)
    (display " - building and solving deformed shape equations - ")
    (solve 2 2)
    (display "\n - commit, end, and refacet - ")
    (commit)
    (end)
    
    (entity:check ds-block)
    (set! ds-model tmp-face)
    (ds:mouse ds-model)
    (display "\n - restart sculpting - ")
    
    (e)
    (solve)
    (ds:get-tag-summary ds-model 1)
    (display "\n - increase pressure load - ")
    (gain ds-dp1 100)
    (solve)
    (display "\n - commit, end, and refacet - ")
    (commit)
    (end)
    ; (refacet ds-block) ;; now a part of ds:commit
    (entity:check ds-block)
    
    (solid:subtract ds-block (solid:cylinder
                               (position 0 -10 10) (position 0 40 10) 5))
    (entity:check ds-block)
    (set! ds-model tmp-face)
    (ds:mouse ds-model)
    (display "\n - begin sculpting of modified body - ")
    (e)
    (solve 2 3)
    (ds:get-tag-summary ds-model 1)
    (display "\n - decrease pressure load - ")
    (gain ds-dp1 -100)
    (solve 2 3)
    (display "\n - commit, end, and refacet - ")
    (commit)
    (end)
    ; (refacet ds-block)  ;; now a part of ds:commit
    (entity:check ds-block)
    
    ;  (debug:file "slabtst1.dbg")
    ;  (entity:debug ds-block 4)
    ;  (debug:file "stdout")
    ;  (display "done - Try (gain ds-dp1 200)\n")
    
    )) ; end slab-bugtest

; acis exit bug sequence
(define (dsbug1) (pinned-square) (exit) )
(define (nodsbug1) (pinned-square) (rbd:clear) (exit) )

(define (dcase) ; still broken
  ; (ds:journal-on "dcase.jou")
  (pinned-square)
  (ds:add-patch ds-model 2 3 (par-pos .1 .1)
                (par-pos .9 .9)
                (par-pos .2 .2) 3)
  (st 12)
  (solve)
  (ds:set-tang-gain ds-model 13 1.3)
  (ds:set-tang-gain ds-model 14 1.3)
  (ds:set-tang-gain ds-model 15 1.3)
  (ds:set-tang-gain ds-model 16 1.3)
  (ds:set-tang-gain ds-model 17 1.3)
  (ds:set-tang-gain ds-model 18 1.3)
  (ds:set-tang-gain ds-model 19 1.3)
  (ds:set-tang-gain ds-model 20 1.3)
  (solve)
  ; (ds:journal-off)
  )

;; cylinder test - works
(define (cylinder-test)
  (set! ds-block (solid:cylinder (position 0 0 0) (position 0 30 0) 10))
  (ds:select-face)
  (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .25))
  (ds:split-domain ds-model 2 (list (par-pos .2 .2)
                                    (par-pos .4 .4)
                                    (par-pos .6 .6)
                                    (par-pos .8 .8)))
  (display "try tracking the constraint point\n")
  ;; commits ok - but fails to restart with (ds:pick-face)
  )

;; interior test - works
(define (interior-test)
  (cylinder-test)
  (sxyz 7 -3 14 25)
  (grid 30)
  (display "exercising interior state\n")
  (ds:get-interior-state ds-model)
  (ds:set-interior-state ds-model 2 0) (solve)
  (ds:get-interior-state ds-model)
  (ds:set-interior-state ds-model 2 1) (solve)
  (ds:get-interior-state ds-model)
  (ds:set-interior-state ds-model 2 0) (solve)
  (commit) (ds:get-interior-state ds-model)
  (ds:set-interior-state ds-model 2 1) (solve)
  (commit) (ds:get-interior-state ds-model)
  (display "done\n")
  )

;; sphere test
(define (sphere-test)
  (set! ds-block (solid:sphere (position 0 0 0) 10))
  (ds:select-face)
  (grid 40) (size 5)
  (ds:add-pt-cstrn ds-model 1 "position" (par-pos .45 .7))
  (sxyz 5 1.7 -20 -1)
  (display "try tracking the constraint point\n")
  )

(define (cl2-bug) ; still broken
  (pull-path) (b) (size 5)
  (define child-tag
    (ds:add-patch ds-model 2 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  (define grandchild-tag
    (ds:add-patch ds-model child-tag 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  
  (define child2-tag
    (ds:add-patch ds-model 2 1 (par-pos .7 .7)
                  (par-pos .9 .9)
                  (par-pos .9 .9) 3) )
  (define grandchild-tag
    (ds:add-patch ds-model child2-tag 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  (commit) (commit)
  (end)
  (clear)
  )
(define (cl-bug) ; still broken
  (pull-path) (b) (size 5)
  (define child-tag
    (ds:add-patch ds-model 2 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  (define grandchild-tag
    (ds:add-patch ds-model child-tag 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  
  (define child2-tag
    (ds:add-patch ds-model 2 1 (par-pos .7 .7)
                  (par-pos .9 .9)
                  (par-pos .9 .9) 3) )
  (commit)
  (end)
  (clear)
  )

(define (clear-bug) ; still broken
  (pull-path) (b) (size 5)
  (define child-tag
    (ds:add-patch ds-model 2 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  (define grandchild-tag
    (ds:add-patch ds-model child-tag 1 (par-pos .2 .2)
                  (par-pos .6 .6)
                  (par-pos .6 .6) 3) )
  (commit)
  (end)
  (clear)
  )

;; run simple journal sequence
(define (djourn)  ; still borken until the dshusk constructors
  ; are changed to pass in dof_vec and dof_def
  ; instead of updating them after they are built
  (ds:journal-on "test.jou" 0)
  (hinged-square) (solve)
  (ds:journal-off)
  (end) (clear)
  (ds:journal-play "test.jou")
  (clear)
  )




(define (ds001)   ; working
  ; (view:dl 0 0 300 300)
  (iso)
  (define wig (solid:wiggle 100 100 50 1 2 -2 1))
  (set! ds-model
        (pick:face (ray (position 0 0 0) (gvector 0 0 1))))
  (part:entities)
  ;bmt(entity:erase  wig)
  (ds:set-icon-radius ds-model 6)
  (define cc1)
  (set! cc1 (ds:add-pt-cstrn ds-model 2 "position"
                             (par-pos .5 .5)))
  (ds:set-cstrn-behavior ds-model 3 "pn")  ; new
  (ds:set-cstrn-behavior ds-model 4 "pn")  ; new
  (ds:set-cstrn-behavior ds-model 5 "pn")   ; new
  (ds:set-cstrn-behavior ds-model 6 "pn")   ; new
  (ds:set-pt-xyz ds-model cc1 0 (position 20 20 70))
  (ds:solve ds-model)
  (ds:commit ds-model)
  (define sb (car (part:entities)))
  (entity:display sb)
  (ds:end-sculpting ds-model)
  ;(entity:erase ds-model)
  (render)
  
  )

;; bugs resolved


(define (dsbug) ; resolved
  (ds:get-tag-summary (ds:test-face 6 6 ) )
  (part:clear)
  (solid:wiggle 100 100 50 1 2 -2 1)
  )

(define (patch-bug1)  ; resolved
  (pinned-square 8 8)
  (ds:elevate-degree ds-model 1 1)
  (add-patch .6 .2 .8 .6)   ;; add patch to root (child)
  (add-patch .2 .4 .5 .7)   ;; add patch to child (grandchild)
  (solve)
  )

(define (pbug) ; resolved
  (set! ds-model (ds:test-face 4 4        ; u_count v_count
                               36 36 0    ; x_size y_size z_size
                               0          ; rational_flag
                               2 2))      ; degree_u degree_v
  ;bmt(entity:erase ds-model)
  ; (ds:set-integral-degree ds-model 6)
  (ds:set-default-shape ds-model 1 0)
  (p4) (t4)
  (dp 20000   .2 .2   .4 .8)
  (solve)
  (ds:mouse ds-model)
  )

; parts with rotations fail to intersect correctly
; so that adding pt-cstrns by mouse does not work.
(define (transbug)   ; working
  (do-nurbs)
  (pinned-square) (commit)
  (define ds-part ds-model) (end)
  (entity:transform (car (part:entities)) (transform:rotation
                                            (position 5 5 0)
                                            (gvector  5 5 0)
                                            45))
  (ds:pick-face)
  )


(define (crvpatch-bug)  ; working
  (pull-path)
  (b)
  (add-patch .2 .2 .4 .4)
  (solve)
  (commit)
  (end)
  (clear)
  )

(define (rmpatch-bug)   ; working
  (pinned-square)
  (define p1 (add-patch .2 .2 .5 .5))
  (solve)
  (ds:rm-patch ds-model p1)
  (solve)
  )

(define (multitag-bug)  ; working
  (pinned-edge)
  (ds:rm-tag-object ds-model 5)
  (ds:commit ds-model)
  (part:save "temp.tmp")
  (part:clear)
  (set! ds-entity-list (part:load "temp.tmp"))
  (set! ds-model (car (entity:edges (car ds-entity-list))))
  (ds:mouse ds-model #f)
  (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5))
  (ds:get-tag-summary ds-model)
  ) ;; end multitag-bug

(define (bezier-bug)
  (set! ds-model (ds:test-face 11 11             ; cpt counts
                               36 36 0           ; xyz sizes
                               ds-rational-flag  ; rational flag
                               10 10             ; uv degrees
                               0 0               ; x0 y0
                               0 0               ; domain min
                               1 1))             ; domain max
  ;bmt(entity:erase (entity:owner ds-model))
  (ds:mouse ds-model #f)
  (size 5) (b)
  (ds:set-default-shape ds-model 2 0)
  ; (ds:add-str-cstrn ds-model 2 "p" (par-pos 1 0) (par-pos 1 1))
  ; (ds:add-str-cstrn ds-model 2 "p" (par-pos 0 1) (par-pos 0 0))
  (ds:toggle-cstrn ds-model 3)
  (ds:toggle-cstrn ds-model 5)
  (ds:add-pt-cstrn ds-model 2 "p" (par-pos .5 .5))
  ; (set! ds-spr (ds:add-spring ds-model 2 (par-pos .5 .5) 1))
  ; (ds:set-load-gain ds-model ds-spr 100)
  (solve)
  (commit)
  )

;; scheme macro to build a deformable curve
;; save it to a file and retrieve it
;; to see if the tags have changed
(define (curv-tag)
  (display "save an edge test \n")
  (part:clear)
  (set! ds-model '())
  ; build an edge and exercise it
  (set! ds-model (ds:test-edge 9 36 0
                               0 3 0.0
                               0.0 25.0))
  ;bmt(entity:erase ds-model)
  (ds:set-alpha ds-model 1 1.2)
  (ds:set-beta ds-model 1 5)
  (ds:set-dynamics ds-model 1 1 0 0)
  (ds:set-draw-state ds-model 1 (+ 4 8))
  (ds:mouse ds-model #f)
  (ds:set-tan-display-gain ds-model 1 (* (- 25.0 0.0) .6))
  
  ; remove the default shape
  (ds:set-default-shape ds-model 1 0)
  
  ; add a pt_cstrn in the middle
  (ds:add-pt-cstrn ds-model 1 "position" (par-pos .5 .5))
  (ds:set-draw-state ds-model 2  (+ 4
                                    8
                                    16))
  (ds:solve ds-model 1)
  
  ; look at the current tags
  (ds:get-tag-summary ds-model)
  
  ; commit
  (ds:commit ds-model)
  
  ; save and retrieve the part
  (display "saving part\n")
  (part:save "temp.tmp")
  
  ; delete the part
  (part:clear)
  
  ; retrieve the part from file
  (display "retrieving part\n")
  (set! ds-entity-list (part:load "temp.tmp"))
  (set! ds-model (car (entity:edges (car ds-entity-list))))
  ;bmt(entity:erase ds-model)
  
  ; rebuild the deformable model and exercise it
  (ds:mouse ds-model #f)
  (ds:solve ds-model 1)
  
  ; look at the tag numbers one more time
  (ds:get-tag-summary ds-model)
  )

(define (dsbug-spring-set-plus-curve-load)
  ;; DS spring set + (curve load or curve constraint): dssscc.scm
  
  ;; log the session
  (set! load-noisily? #t)
  
  ;; make a test face
  (define my_dsmodel1 ( ds:test-face 6 6          ; cpt counts
                        36 36 0))    ; xyz sizes
  (ds:solve my_dsmodel1 1 1)
  
  ;; define point constraint
  (define pc1 ( ds:add-pt-cstrn my_dsmodel1 1 "position" ( par-pos 0 0)))
  
  ;; convert constraint to load
  (ds:crv-load-from-cstrn my_dsmodel1 pc1)
  
  ;; add spring set attractor
  (ds:add-spring-set my_dsmodel1 1 (ds:test-scatter 65 36 36 25) 5000)
  
  (ds:solve my_dsmodel1 1 1)
  (part:clear)
  
  ; make a test face
  (define my_dsmodel2 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel2 1 1)
  
  ;; set tang gain
  (ds:set-tang-gain my_dsmodel2 1)
  
  ;; set disp gain
  (ds:set-tan-display-gain my_dsmodel2 1)
  
  ;; journalling not yet available
  ;;(ds:journal-on)
  ;;(ds:journal-off)
  ;;(ds:journal-play)
  
  ;; load gain
  (ds:set-load-gain my_dsmodel2 1 3)
  
  ;; shape knots
  (ds:get-shape-knots my_dsmodel2 1)
  
  ;; icon radius
  (ds:get-icon-radius my_dsmodel2)
  
  ;; set icon radius
  (ds:set-icon-radius my_dsmodel2 10)
  
  ;; check it
  (ds:get-icon-radius my_dsmodel2)
  
  ;; add a spring load
  (define cc1 ( ds:add-spring-curve my_dsmodel2 1( par-pos 0 0.5) ( par-pos 0.5 0) ( position 0 18 10) ( position 18 0 20) 1000))
  
  ;; create convert constraint from load
  (ds:crv-cstrn-from-load my_dsmodel2 cc1)
  
  ;; set slide state - function not available 12/7/98
  ;;(ds:set-slide-state my_dsmodel2 1 1)
  
  ;; load gain
  (ds:get-load-gain my_dsmodel2 1)
  
  ;; end conditions
  (ds:get-end-conds my_dsmodel2)
  (ds:set-end-conds my_dsmodel2 0 -1 0 -1)
  (ds:get-end-conds my_dsmodel2)
  
  ;; disp gain
  (ds:get-tan-display-gain my_dsmodel2 1)
  
  ;; element count
  (ds:get-elem-count my_dsmodel2 1)
  ;; set element count - not in release 12/7/98
  ;;(ds:set-elem-count my_dsmodel2 1 20 20)
  ;; check it
  (ds:get-elem-count my_dsmodel2 1)
  
  ;; elevate degree
  (ds:elevate-degree my_dsmodel2 1 1)
  
  ;; set constraint state
  (ds:set-cstrn-state my_dsmodel2 8 1)
  
  ;; add spring set(attractor)
  (ds:add-spring-set my_dsmodel2 1 (ds:test-scatter 65 36 36 25) 5000)
  (ds:solve my_dsmodel2 1 1)
  
  ;; end scuplting
  (ds:end-sculpting my_dsmodel2)
  
  ;; remove tag object
  (ds:rm-tag-object my_dsmodel2 1)
  )

(define (dsbug-dof-state)
  ; Script to demonstrate (ds:get-dof-state non-ds-entity) segv error
  (hung-square 8)      ; probably can be anything
  (part:entities)          ;returns #[entity 1 1]
  ds-model               ;returns #[entity 2 1]
  ;Note - it's not clear why ds-model isn't showing up in (part:entities)
  ;  perhaps ds-model is in a different part
  (ds:get-dof-state ds-model)  ; returns (64 59 5 5 0 0)
  (ds:get-dof-state (entity 1))  ; returns "ds:get-dof-state: segmentation error"
  )

(define (dsbug-circ-cstrn-plus-spring)
  ;; DS (circle constraint or parabolic constraint) + spring load: dsccpcsl.scm
  
  ;; log the session
  (set! load-noisily? #t)
  
  ;; make a test face
  (define my_dsmodel1 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel1 1 1)
  
  ;; add parabolic constraint
  (ds:add-parab-cstrn my_dsmodel1 1 "p" (par-pos .70 .70) (par-pos .75 .75) (par-pos .90 .90))
  
  ;; add spring(attractor)
  (ds:add-spring my_dsmodel1 1 (par-pos .2 .2) (position 10 10 10) 5000)
  (ds:solve my_dsmodel1 1 1)
  (part:clear)
  
  ; make a test face
  (define my_dsmodel2 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel2 1 1)
  
  ;; add circle constraint
  (ds:add-circ-cstrn my_dsmodel2 1 "p" (par-pos .75 .75) (par-pos .70 .70) (par-pos .90 .90))
  ;;(ds:add-circ-cstrn my_dsmodel2 1 "p" (par-pos .75 .75) (par-pos .10 .10) (par-pos .15 .15))
  
  ;; add dist pressure
  (ds:add-dist-press my_dsmodel2 1  50)
  (ds:solve my_dsmodel2 1 1)
  
  )

(define (dsbug-dist-press-plus-spring)
  ;; DS dist pressure plus spring load: dsdpsl.scm
  
  ;; log the session
  (set! load-noisily? #t)
  
  ;; make a test face
  (define my_dsmodel1 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel1 1 1)
  
  ;; default state 1 -> used
  (ds:get-default-state my_dsmodel1 1)
  
  ;; dump description
  (ds:debug my_dsmodel1 1)
  
  ;; draw grid?
  (ds:get-draw-grid my_dsmodel1 1)
  ;; set it
  (ds:set-draw-grid my_dsmodel1 1 40)
  ;; check it
  (ds:get-draw-grid my_dsmodel1 1)
  
  ;; draw state
  (ds:get-draw-state my_dsmodel1 1)
  ;; set it
  (ds:set-draw-state my_dsmodel1 1 (+ ds-draw-loads))
  ;; check it
  (ds:get-draw-state my_dsmodel1 1)
  
  ;; define a spring(constraint) on the test face
  ;; note:  springs attract
  (ds:add-spring-curve my_dsmodel1 1 (par-pos .60 .60) (par-pos .95 .95) (position 0 18 10) (position 18 0 20) 100)
  
  ;; spring length
  (ds:get-spring-length my_dsmodel1 1 10)
  
  ;; add distributed pressure to entire face
  (ds:add-dist-press my_dsmodel1 1 50000)
  (ds:solve my_dsmodel1 1 1)
  ;;(part:clear)
  
  ;; commit to ACIS?
  (ds:commit my_dsmodel1)
  )

(define (dsbug-dscstrn)
  ;; DS add constraints: dscstrn.scm
  
  ;; log the session
  ; (set! load-noisily? #t)
  ; (journal:on "c:\\dsreg\\dscstrn.jrl")
  
  ;; make a test face
  (define my_dsmodel1 ( ds:test-face 6 6 36 36 0))
  
  ;; define a point constraint(in parametric space) on the test face
  ;; note that the point constraint is on the surface -> will not likely deform in that area
  (ds:add-cstrn my_dsmodel1 1 "point" "position" ( par-pos .05 .05))
  (ds:solve my_dsmodel1 1 1)
  
  ;; add pressure at uv point away from constrained point
  (ds:add-pt-press my_dsmodel1 1 (par-pos .8 .8) 50000)
  (ds:solve my_dsmodel1 1 1)
  (part:clear)
  
  ;; make a test face
  (define my_dsmodel2 ( ds:test-face 6 6 36 36 0))
  
  ;; define a straight line constraint(in parametric space) on the test face
  ;; note that the straight line constraint is on the surface -> will not likely deform in that area
  (ds:add-cstrn my_dsmodel2 1 "straight" "position" ( par-pos .05 .05) (par-pos .15 .15))
  (ds:solve my_dsmodel2 1 1)
  
  ;; add pressure at uv point away from straight line constraint
  (ds:add-pt-press my_dsmodel2 1 (par-pos .85 .85) 50000)
  (ds:solve my_dsmodel2 1 1)
  (part:clear)
  
  ;; make a test face
  (define my_dsmodel3 ( ds:test-face 6 6 36 36 0))
  
  ;; define a parabola constraint(in parametric space) on the test face
  ;; note that the parabola constraint is on the surface -> will not likely deform in that area
  (ds:add-cstrn my_dsmodel3 1 "parabola" "position" ( par-pos .05 .05) (par-pos .15 .15) (par-pos .25 .25))
  (ds:solve my_dsmodel3 1 1)
  
  ;; add pressure at uv point away from constraint parabola
  (ds:add-pt-press my_dsmodel3 1 (par-pos .8 .8) 50000)
  (ds:solve my_dsmodel3 1 1)
  (part:clear)
  
  ;; make a test face
  (define my_dsmodel4 ( ds:test-face 6 6 36 36 0))
  
  ;; define a circular constraint(in parametric space) on the test face
  ;; note that the circular constraint is on the surface -> will not likely deform in that area
  (ds:add-cstrn my_dsmodel4 1 "circ" "position" (par-pos .30 .30) (par-pos .10 .10) (par-pos .10 .10))
  ;; **** the following statement causes seg-v and access violations, the program crashes
  ;;(ds:add-cstrn my_dsmodel4 1 "circ" "position" ( par-pos .30 .30) (par-pos .05 .05) (par-pos .60 .60))
  (ds:get-dof-state my_dsmodel4)
  (ds:solve my_dsmodel4 1 1)
  
  ;; add pressure at uv point away from circular constraint
  (ds:add-pt-press my_dsmodel4 1 (par-pos .8 .8) 15000)
  (ds:solve my_dsmodel4 1 1)
  )

(define (dsbug-attractor-plus-curve)
  ;; DS atrractor plus curve load, parabolic load, and circle load: dsaload.scm
  
  ;; log the session
  ; (set! load-noisily? #t)
  ; (journal:on "c:\\dsreg\\dsaload.jrl")
  
  ;; make a test face
  (define my_dsmodel1 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel1 1 1)
  
  ;; define a curve constraint on the test face
  ;; note that the curve constraint is on the face
  (ds:add-str-load my_dsmodel1 1 (par-pos .90 .90) (par-pos .95 .95)  5)
  
  ;; add "magnet" at xyz point away from constrained area
  (ds:add-attractor my_dsmodel1 1 (position 10 10 10) 500000)
  (ds:solve my_dsmodel1 1 1)
  (part:clear)
  
  ;; make a test face
  (define my_dsmodel2 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel2 1 1)
  
  ;; define a parab constraint on the test face
  ;; note that the parab constraint is on the face
  (ds:add-parab-load my_dsmodel2 1 (par-pos .80 .80) (par-pos .95 .95) (par-pos .98 .98)  5)
  
  ;; add "magnet" at xyz point away from constrained area
  (ds:add-attractor my_dsmodel2 1 (position 10 10 10) 500000)
  (ds:solve my_dsmodel2 1 1)
  (part:clear)
  
  ;; make a test face
  (define my_dsmodel3 ( ds:test-face 6 6 36 36 0))
  (ds:solve my_dsmodel3 1 1)
  
  ;; define a circle constraint on the test face
  ;; note that the circle constraint is on the face
  (ds:add-circ-load my_dsmodel3 1 (par-pos .90 .90) (par-pos .80 .80) (par-pos .95 .95)  5)
  
  ;; add "magnet" at xyz point away from constrained area
  (ds:add-attractor my_dsmodel3 1 (position 10 10 10) 500000)
  (ds:solve my_dsmodel3 1 1)
  ) ;; dsbug-attractor-plus-curve


(define (box-6bug)
  (box-6mesh) (solve 5) (commit) (end)
  (set! ds-dm2 (solid:cylinder (position 5 15 -5) (position 5 15 35) 5))
  (bool:subtract ds-dm1 ds-dm2)
  
  ; pick a face with semicircle scooped out
  ;  (ds:pick-face)
  
  ; put cstrn pt in face and move it away from box
  ; should see 3 links turned off
  ;  (commit)
  ; should get an Access violation
  )

(define (elevate-mesh)
  (pinned-2mesh)
  (solve)
  (ds:elevate-degree ds-model 2 0)
  (solve)
  (clear)
  
  (pinned-2mesh)
  (solve)
  (ds:elevate-degree ds-model 2 1)
  (solve)
  )

(define (split-mesh)
  (pinned-2mesh)
  (solve)
  (ds:split-domain ds-model 2 (list (par-pos .5 .5)))
  (solve)
  )

(define (extrapolate-mesh)
  ;; when this function executes successfully, it will
  ;; signal the error DS_MULTI_SURF_EXTRAPOLATE
  (pinned-2mesh)
  (solve)
  (ds:extrapolate ds-model 2 )
  (solve)
  )

(define (isolate-square)
  (pinned-square 20)
  (ds:add-area-cstrn ds-model 2 0 (par-pos .1 .2) (par-pos .7 .9))
  (display "added area cstrn")
  (solve)
  (display " - and solved\n")
  )

(define (c2-edge)
  (pinned-edge)
  (ds:set-pt-xyz ds-model 5 0 (position 18 0 18))
  (solve)
  (behavior 5 'ptc)
  (solve)
  )

(define (c2-seam)
  (pinned-edge)
  (ds:set-pt-xyz ds-model 5 0 (position 18 15 1)) (solve)
  (define patch (ds:add-patch ds-model 2 1
                              (par-pos .15 0)
                              (par-pos .85 0)
                              (par-pos 0 0)
                              3))
  (define pt (ds:add-pt-cstrn ds-model patch 'p
                              (par-pos .5 0)))
  (define pos (ds:get-pt-xyz ds-model pt 0))
  (behavior 7 'ptc)
  (solve)
  (ds:set-pt-xyz ds-model pt 0 pos)
  (solve)
  )

(define (c2-seam-1)
  (pinned-edge)
  (ds:set-pt-xyz ds-model 5 0 (position 18 15 1)) (solve)
  (ds:elevate-degree ds-model 2 1)
  (ds:elevate-degree ds-model 2 1)
  (define patch (ds:add-patch ds-model 2 1
                              (par-pos .15 0)
                              (par-pos .85 0)
                              (par-pos 0 0)
                              3))
  (define pt (ds:add-pt-cstrn ds-model patch 'p
                              (par-pos .5 0)))
  (define pos (ds:get-pt-xyz ds-model pt 0))
  (behavior 7 'ptc)
  (solve)
  (ds:set-pt-xyz ds-model pt 0 pos)
  (solve)
  )

(define (c2-seam-2)
  (pull-path)
  (define patch (ds:add-patch ds-model 2 1
                              (par-pos .16 0)
                              (par-pos .35 0)
                              (par-pos 0 0)
                              3))
  (define pt (ds:add-pt-cstrn ds-model patch 'p
                              (par-pos .5 0)))
  (define pos (ds:get-pt-xyz ds-model pt 0))
  (behavior 7 'ptc)
  (solve)
  (ds:set-pt-xyz ds-model pt 0 pos)
  (solve)
  )

(define (normal-square-bug1)
  (clear)
  (normal-square)
  (ds:set-pt-xyz ds-model 11 0 (position 18 18 18)) (solve)
  (ds:set-pt-xyz ds-model 11 4 (position 12 20 25)) (solve)
  (shape 1)
  (ds:set-pt-xyz ds-model 11 0 (position 18 18 -13))(solve)
  (shape 1)
  (ds:set-pt-xyz ds-model 11 0 (position 18 18 25))(solve)
  (delta 5)
  ; at this time the blue normal vector is not coincident with
  ; the yellow target value.  (only seen when compiled with
  ; DSDEBUG)
  
  ; executing the following fixes the problem
  ;   (ds:set-pt-xyz ds-model 11 4 (position 17.5 19 35)) (solve)
  
  )

(define (menger-sponge n)
  (let ( (min 0)
         (max 100)
         (current-center (position 50 50 50))
         (current-length (/ 100 3))
         (sponge '())
         )
    
    ; build a block to be the sponge
    (set! sponge (solid:block (position min min min)
                              (position max max max)))
    
    ; cut in the "x", "y', and "z" directions
    (menger-cut n sponge current-center current-length min max "x")
    (menger-cut n sponge current-center current-length min max "y")
    (menger-cut n sponge current-center current-length min max "z")
    
    )) ; end let and define menger-sponge

(define (menger-cut         ;; create a 0 volume fractal (in the limit)
          n                   ; recursion limit
          sponge              ; the solid model of the sponge
          center              ; current sub cube center
          length              ; current sub cube length
          min                 ; original cube corner
          max                 ; original cube corner (scalar)
          dir)                ; normal orientation   (scalar)
  
  ( let ( (x_min (if (equal? dir "x")
                     (- min 1)
                     (- (position:x center) (/ length 2))))
          (y_min (if (equal? dir "y")
                     (- min 1)
                     (- (position:y center) (/ length 2))))
          (z_min (if (equal? dir "z")
                     (- min 1)
                     (- (position:z center) (/ length 2))))
          (x_max (if (equal? dir "x")
                     (+ max 1)
                     (+ (position:x center) (/ length 2))))
          (y_max (if (equal? dir "y")
                     (+ max 1)
                     (+ (position:y center) (/ length 2))))
          (z_max (if (equal? dir "z")
                     (+ max 1)
                     (+ (position:z center) (/ length 2))))
          (g1    (cond ((equal? dir "x") (gvector 0 length 0))
                       ((equal? dir "y") (gvector 0 0 length))
                       ((equal? dir "z") (gvector length 0 0))))
          (g2    (cond ((equal? dir "x") (gvector 0 length length))
                       ((equal? dir "y") (gvector length 0 length))
                       ((equal? dir "z") (gvector length length 0))))
          (g3    (cond ((equal? dir "x") (gvector 0 0 length))
                       ((equal? dir "y") (gvector length 0 0))
                       ((equal? dir "z") (gvector 0 length 0))))
          (g4    (cond ((equal? dir "x") (gvector 0 (- length) length))
                       ((equal? dir "y") (gvector length 0 (- length)))
                       ((equal? dir "z") (gvector (- length) length 0))))
          (g5    (cond ((equal? dir "x") (gvector 0 (- length) 0))
                       ((equal? dir "y") (gvector 0 0 (- length)))
                       ((equal? dir "z") (gvector (- length) 0 0))))
          (g6    (cond ((equal? dir "x") (gvector 0 (- length) (- length)))
                       ((equal? dir "y") (gvector (- length) 0 (- length)))
                       ((equal? dir "z") (gvector (- length) (- length) 0))))
          (g7    (cond ((equal? dir "x") (gvector 0 0 (- length)))
                       ((equal? dir "y") (gvector (- length) 0 0))
                       ((equal? dir "z") (gvector 0 (- length) 0))))
          (g8    (cond ((equal? dir "x") (gvector 0 length (- length)))
                       ((equal? dir "y") (gvector (- length) 0 length))
                       ((equal? dir "z") (gvector length (- length) 0))))
          ) ; end let name definitions
    
    ; work condition: n > 0
    (cond ((> n 0)
           
           ; subtract a hole
           (display "\n subtracting a hole\n")
           (define hole (solid:block (position x_min y_min z_min)
                                     (position x_max y_max z_max)))
           (set! sponge (solid:subtract sponge hole))
           
           ; generate the 8 recursive calls
           (menger-cut (- n 1) sponge (position:offset center g1) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g2) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g3) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g4) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g5) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g6) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g7) (/ length 3) min max dir)
           (menger-cut (- n 1) sponge (position:offset center g8) (/ length 3) min max dir)
           )) ; end cond and cond block for (> n 0)
    ) ; end let block
  ) ; end define menger-cut

(define (c2-bug)
  (let ((this-model '()))
    (pinned-3mesh)
    (set! this-model ds-model)
    (delete 31 ) (solve)
    
    ; exercise the 2c constraint in combinations
    (behavior 14 'pll_coo) (behavior 3 'pll_coo) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_coo) (behavior 4 'pll_cll) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_cll) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_cll) (behavior 4 'pll_cll) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_coo) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_coo) (behavior 4 'pll_cll) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_cll) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_cll) (behavior 4 'pll_cll) (solve)
    
    ; commit the model and rebuild from persistent storage
    (commit)
    (end)
    (rbd:clear)
    (display this-model)
    (set! ds-model this-model)
    (ds:mouse ds-model)
    (view:refresh)
    ;bmt(entity:erase (entity:owner ds-model))
    
    ; now exercise the combinations
    ; current bug - some combinations are now broken
    (behavior 14 'pll_coo) (behavior 3 'pll_coo) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_coo) (behavior 4 'pll_cll) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_cll) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_coo) (behavior 3 'pll_cll) (behavior 4 'pll_cll) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_coo) (behavior 4 'pll_coo) (solve)
    (behavior 14 'pll_cll) (behavior 3 'pll_coo) (behavior 4 'pll_cll) (solve) ; broken
    (behavior 14 'pll_cll) (behavior 3 'pll_cll) (behavior 4 'pll_coo) (solve) ; broken
    (behavior 14 'pll_cll) (behavior 3 'pll_cll) (behavior 4 'pll_cll) (solve) ; broken
    
    ))

(define (c1-bug)
  (let ((this-model '()))
    (pinned-3mesh)
    (set! this-model ds-model)
    (delete 31 ) (solve)
    
    ; exercise the 2c constraint in combinations
    (behavior 14 'pll_too) (behavior 3 'pll_too) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_too) (behavior 4 'pll_tll) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_tll) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_tll) (behavior 4 'pll_tll) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_too) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_too) (behavior 4 'pll_tll) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_tll) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_tll) (behavior 4 'pll_tll) (solve)
    
    ; commit the model and rebuild from persistent storage
    (commit)
    (end)
    (rbd:clear)
    (display this-model)
    (set! ds-model this-model)
    (ds:mouse ds-model)
    (view:refresh)
    ;bmt(entity:erase (entity:owner ds-model))
    
    ; now exercise the combinations
    ; current bug - some combinations are now broken
    (behavior 14 'pll_too) (behavior 3 'pll_too) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_too) (behavior 4 'pll_tll) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_tll) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_too) (behavior 3 'pll_tll) (behavior 4 'pll_tll) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_too) (behavior 4 'pll_too) (solve)
    (behavior 14 'pll_tll) (behavior 3 'pll_too) (behavior 4 'pll_tll) (solve) ; broken
    (behavior 14 'pll_tll) (behavior 3 'pll_tll) (behavior 4 'pll_too) (solve) ; broken
    (behavior 14 'pll_tll) (behavior 3 'pll_tll) (behavior 4 'pll_tll) (solve) ; broken
    
    ))


(define (space-patch-bug)
  (let ((this-model '()))
    (space-bug)
    (set! this-model ds-model)
    (ds:add-patch ds-model 2 1 (par-pos .75 .82)
                  (par-pos .29 .73)
                  (par-pos 0   0) 3)
    (solve)
    (ds:add-dist-press ds-model 12 1000 )
    (gain 17 5000) (gain 17 10000) (gain 17 15000)
    (commit)
    (end)
    (rbd:clear)
    (set! ds-model this-model)
    (ds:mouse ds-model)
    (ds:set-pt-xyz ds-model 7 0 (position 18 18 40))
    (solve)
    ; the bug: the patch moves
    ))

(define (pinned-2mesh-fix)
  (pinned-2mesh)
  (behavior 4 'pff_coo) (solve)   ; ok
  (behavior 4 'pff_cll) (solve)   ; ok
  (behavior 4 'pff_cff) (solve)   ; ok now, will break next time
  (behavior 4 'pll_cll) (solve)   ; ok
  (behavior 4 'pff_cff) (solve)   ; now its broken
  )

(define (bulletin-bug)
  (let ((this-model '()))
    
    ;; a broken sequence
    (pinned-square)(ds-io);bmt(entity:erase ds-model)
    ;; the bug = a bulletin board warning
    
    ;; start a nearly equivalent working sequence
    (pinned-square)
    (set! this-model ds-model)
    (commit)
    (end)
    (rbd:clear)
    (set! ds-model this-model)
    (ds:mouse ds-model)
    ;bmt(entity:erase ds-model)
    ;; all this works, no bugs here no warning messages
    
    ;; now try the bug again to prove it is not order dependent
    (clear) (pinned-square)(ds-io);bmt(entity:erase ds-model)
    ; the bug = a bulletin board warning
    ))

(define (ds:track-curve . opt)   ; opt = (tag tgt)
  (let ( (tag-type -1)        ; tag = crv or link cstrn to track
         ; tgt = 1 or 2 for link cstrns
         (tag (if (not (null? opt)) (car opt) 0))
         (tgt (if (not (or (null? opt) (null? (cdr opt))) )
                  (cadr  opt)  1))
         )
    
    ;; (display "\n ENTERING ds:track-curve")
    ;; (display "\n   tag = ") (display tag)
    ;; (display "\n   tgt = ") (display tgt)
    ;; (display "\n")
    ; ask for a pick when the tag is not given
    (cond ( (= tag 0)
            (display "  Pick link/curve constraint to track: ")
            (define tag_pair (ds:pick-tag-id ds-model (read-event)))
            (set! tag (car tag_pair))
            (display "\n  ")
            ) ; end no tag given condition
          ) ; end cond switch for picking a tag value
    
    ; get the tag's type
    (set! tag-type (if (not (= tag -1))
                       (ds:get-tag-type ds-model tag)
                       -1))
    
    ; check the tag type
    (cond (  (or (= tag-type 10)  ;; crv_cstrn not a seam
                 (= tag-type 6)   ;; crv_load a seam
                 (= tag-type 11)  ;; crv_cstrn a seam
                 (= tag-type 16) ;; link_cstrn
                 (= tag-type 18)) ;; link_load
             (set! ds-model2
                   (ds:make-tracking-curve ds-model tag tgt))
             (display "tracking curve tag (ds-model2 = ")
             (display ds-model2)
             (display ")\n")
             
             ;; enable default shape - add end point constraints
             (ds:set-default-shape ds-model ds-model2 1)
             (ds:add-pt-cstrn ds-model ds-model2 "position" (par-pos 0 0))
             (ds:add-pt-cstrn ds-model ds-model2 "position" (par-pos 1 1))
             
             ) ; end type check condition
          ) ; end cond clause
    '()
    )) ; end (ds:track-curve)

(define (track-square . opt)
  (let ( (n (if (not (null? opt)) (car opt) 8)) )
    
    ; simple test case
    (pinned-square n)
    
    ; turn on a curve and disable the end points
    (toggle 3)
    (delete 7)
    (delete 10)
    
    ; make crv_cstrn(3) a tracking curve constraint
    (ds:track-curve 3)
    '()
    ) ; end let block
  ) ; end (track-square)

(define (track-2mesh)
  ; simple test case
  (pinned-2mesh)
  
  ; turn on a curve and disable the end points
  (delete 9)
  (delete 10)
  
  ; make crv_cstrn(4) a tracking curve constraint
  (ds:track-curve 4)
  '()
  
  ) ; end (track-2mesh)


(define (bulletin-bug)
  (let ((this-model '()))
    
    ;; a broken sequenc
    (pinned-square)(ds-io);bmt(entity:erase ds-model)
    ;; the bug = a bulletin board warning
    
    ;; start a nearly equivalent working sequence
    (pinned-square)
    (set! this-model ds-model)
    (commit)
    (end)
    (rbd:clear)
    (set! ds-model this-model)
    (ds:mouse ds-model)
    ;bmt(entity:erase ds-model)
    ;; all this works, no bugs here
    
    ;; now try the bug again to prove its not order depenendent
    (clear) (pinned-square)(ds-io);bmt(entity:erase ds-model)
    ; the bug = a bulletin board warning
    ))

(define (box-3mesh-bug)
  (box-3mesh) (ds-aio)
  ; the bug: commit fails due to large tolernaces.
  ; in this case tolerances should be close to zero.
  )

(define (space-bug-bug)
  (space-bug)
  (ds:add-patch ds-model 2 1 (par-pos 0.218 .687)
                (par-pos 0.636 .859)
                (par-pos 0     0)
                3)
  (ds:add-dist-press ds-model 12 100)
  (gain 17 10000)
  (gain 17 50000)
  (ds-aio)
  (ds:set-pt-xyz ds-model 7 0 (position 18 18 32) 1)
  (commit) (end)
  )
